home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD1.iso / Emulatoren / zxam20.lha / ZXAM Spectrum / ZXAM_Rexx / Español / ListBASIC.zxam < prev    next >
Encoding:
Text File  |  1994-10-22  |  2.2 KB  |  87 lines
  1. /* este script saca el listado del BASIC presente en la memoria del */
  2. /* Cpectrum y lo graba como fichero */
  3.     
  4.     /* comprobamos si el emulador está presente */
  5.     address command
  6.     
  7.     if ~show(ports,ZXAM_REXX) then do
  8.         requestchoice '>nil: title "ZXAM Script error..." body "No encuentro el puerto del emulador!!" gadgets "AARGH!"'
  9.         exit
  10.         end
  11.  
  12.     /* debemos listar el BASIC. primero lo localizamos */
  13.     
  14.     /* dir inicio del BASIC (variable PROG) */
  15.     baselist=zxamdpeek(23635)
  16.     
  17.     /* longitud del programa BASIC (con variable VARS) */
  18.     endlist=zxamdpeek(23627)
  19.     
  20.     /* calculamos tamaño */
  21.     longbasic=endlist-baselist
  22.     if longbasic=0 then do
  23.         requestchoice '>nil: title "ZXAM Script error..." body "No hay programa BASIC!!" gadgets "AARGH!"'
  24.         exit 0
  25.         end
  26.     
  27.     /* cogemos toda el area BASIC */
  28.     bloquebasic=zxamgetmem(baselist,endlist-baselist)
  29.     
  30.     
  31.     /* pedimos el nombre y path del fichero */
  32.     oldpath=zxamactsavepath()
  33.     oldpattern=zxamactpattern()
  34.     zxampattern('#?')
  35.     nombre=zxamsaverequester('Nombre para listado BASIC...','ram:')
  36.     zxamsavepath(oldpath)
  37.     zxampattern(oldpattern)
  38.     if nombre='' then exit 0    /* pulsado el CANCEL */
  39.     
  40.     if ~open('fichero',nombre,'w') then exit 0
  41.     
  42.     oldname=zxamactname()        /* nombre actual */
  43.     oldformat=zxamactformat()    /* formato actual */
  44.     
  45.     ZXAMEnableAbort()        /* activa gadget Abort ARexx */
  46.     
  47.     do forever
  48.     
  49.     /* procesamos la linea */
  50.         
  51.         /* imprimimos numero de linea */
  52.         numlinea=c2d(left(bloquebasic,2))
  53.         dummy=writech('fichero','  'numlinea)
  54.         zxamnameformat('     Convirtiendo linea 'numlinea,'Espera...')
  55.         longline=c2d(reverse(substr(bloquebasic,3,2))) /* fomato invertido Z80 */
  56.         do i=5 to 4+longline    /* para procesar los caracteres de la linea */
  57.         if substr(bloquebasic,i,1)='0e'x then do
  58.             i=i+5
  59.             iterate
  60.             end
  61.         dummy=writech('fichero',zxambasictoken(substr(bloquebasic,i,1)))
  62.         
  63.         if zxamreadabort() then do
  64.             if oldname='' then
  65.                 zxamclearnameformat()
  66.             else
  67.                 zxamnameformat(oldname,oldformat)
  68.             exit
  69.             end
  70.         
  71.         end i
  72.         
  73.     dummy=writech('fichero','0a'x)
  74.     
  75.     bloquebasic=right(bloquebasic,length(bloquebasic)-(longline+4))
  76.     if bloquebasic='' then break
  77.     end
  78.     
  79.     dummy=close('fichero')
  80.     
  81.     if oldname='' then
  82.         zxamclearnameformat()
  83.     else
  84.         zxamnameformat(oldname,oldformat)
  85.     
  86.     exit
  87.